analysis/scratchwork/Levels Graphs New CBO.R

In malcalakovalski/fim: Fiscal Impact Measure

###########################################################################
#Getting the levels variables-- applying the MPC but not minus neutral
# Setup -------------------------------------------------------------------
Sys.setenv(TZ = 'UTC')
librarian::shelf(
  "tidyverse",
  "zoo",
  "TTR",
  "tsibble",
  "lubridate",
  "glue",
  "fim",
  "dplyover"
)

options(digits = 4)
options(scipen = 20)
devtools::load_all()


# Wrangle data ------------------------------------------------------------

overrides <- readxl::read_xlsx('data/forecast_06_2021_newCBO.xlsx',
                               sheet = 'historical overrides') %>% 
  select(-name) %>% 
  pivot_longer(-variable) %>% 
  pivot_wider(names_from = 'variable',
              values_from = 'value') %>% 
  rename(date = name) %>% 
  mutate(date = yearquarter(date))
# Load national accounts data from BEA

usna <-
  read_data() %>%
  # Rename Haver codes for clarity
  define_variables() %>%
  # Specify time series structure:
  # Key is historical or forecast period
  # Indexed by date
  as_tsibble(key = id, index = date) %>%
  # Calculate GDP growth for data but take CBO for projection
  mutate_where(id == 'historical',
               real_potential_gdp_growth = q_g(real_potential_gdp)) %>% 
  # Net out unemployment insurance, rebate checks, and Medicare to apply different MPC's
  mutate(
    federal_social_benefits = federal_social_benefits - ui - rebate_checks - medicare,
    state_social_benefits = state_social_benefits - medicaid,
    social_benefits = federal_social_benefits + state_social_benefits,
    consumption_grants = gross_consumption_grants - medicaid_grants,
  ) %>% 
  mutate(rebate_checks_arp = if_else(date == yearquarter("2021 Q1"),
                                     1348.1,
                                     0)) %>%
  mutate_where(id == 'projection',
               rebate_checks_arp = NA,
               federal_ui = NA,
               state_ui = NA) %>% 
  mutate_where(date == yearquarter('2021 Q1'),
               rebate_checks = rebate_checks - rebate_checks_arp,
               federal_social_benefits = federal_social_benefits + 203
  ) %>% 
  mutate(consumption_grants = gross_consumption_grants - medicaid_grants,
         
         # Aggregate taxes
         corporate_taxes = federal_corporate_taxes + state_corporate_taxes,
         non_corporate_taxes = federal_non_corporate_taxes + state_non_corporate_taxes,
         
         
  ) %>% 
  mutate_where(id == 'projection',
               consumption_grants_deflator_growth = state_purchases_deflator_growth,
               investment_grants_deflator_growth = state_purchases_deflator_growth) %>% 
  mutate_where(date >= yearquarter('2020 Q2') & date <= yearquarter('2021 Q1'),
               consumption_grants = overrides$consumption_grants_override) 







# Forecast ----------------------------------------------------------------
forecast <- readxl::read_xlsx('data/forecast_06_2021_newCBO.xlsx',
                              sheet = 'forecast') %>% 
  select(-name) %>% 
  pivot_longer(-variable) %>% 
  pivot_wider(names_from = 'variable',
              values_from = 'value') %>% 
  rename(date = name) %>% 
  mutate(date = yearquarter(date))



projections <- coalesce_join(usna, forecast, by = 'date') %>%
  
  mutate(# Coalesce NA's to 0
    across(where(is.numeric),
           ~ coalesce(.x, 0))) %>%
  mutate(
    health_outlays = medicare + medicaid,
    federal_health_outlays = medicare + medicaid_grants,
    state_health_outlays = medicaid - medicaid_grants
  )

# Consumption -------------------------------------------------------------
consumption <-
  projections %>%
  mutate(social_benefits_minus_neutral= social_benefits, federal_social_benefits_minus_neutral = federal_social_benefits, state_social_benefits_minus_neutral = state_social_benefits, health_outlays_minus_neutral = health_outlays, federal_health_outlays_minus_neutral = federal_health_outlays, state_health_outlays_minus_neutral = state_health_outlays, subsidies_minus_neutral = subsidies, federal_subsidies_minus_neutral = federal_subsidies, state_subsidies_minus_neutral = state_subsidies, federal_ui_minus_neutral = federal_ui, state_ui_minus_neutral = state_ui, rebate_checks_minus_neutral = rebate_checks, corporate_taxes_minus_neutral = corporate_taxes,federal_corporate_taxes_minus_neutral = federal_corporate_taxes, state_corporate_taxes_minus_neutral = state_corporate_taxes,  non_corporate_taxes_minus_neutral = non_corporate_taxes, federal_non_corporate_taxes_minus_neutral = federal_non_corporate_taxes, state_non_corporate_taxes_minus_neutral = state_non_corporate_taxes)  %>% 
  calculate_mpc("social_benefits") %>%
  mutate(rebate_checks_post_mpc = mpc_rebate_checks(rebate_checks_minus_neutral)) %>%
  calculate_mpc("subsidies") %>%
  calculate_mpc("health_outlays") %>%
  calculate_mpc("corporate_taxes") %>%
  calculate_mpc("non_corporate_taxes") %>% 
  mutate(across(c(federal_ui_minus_neutral, state_ui_minus_neutral),
                .fns = ~ if_else(date < yearquarter("2021 Q2"),
                                 mpc_ui(.x),
                                 mpc_ui_arp(.x)),
                .names = '{.col}_post_mpc')) %>% 
  mutate(across(
    .cols = all_of(
      c(
        "rebate_checks_arp",
        "federal_other_direct_aid_arp",
        "federal_other_vulnerable_arp",
        # "federal_ui_arp",
        #"state_ui_arp",
        "federal_aid_to_small_businesses_arp"
      )
    ),
    .fns = ~ .x,
    .names = "{.col}_minus_neutral"
  )) %>% 
  mutate(
    across(
      .cols = any_of(
        c("federal_ui_arp", "state_ui_arp", "federal_other_vulnerable_arp") %>% paste0("_minus_neutral")
      ),
      .fns = ~ mpc_vulnerable_arp(.x),
      .names = "{.col}_post_mpc"
    ),
    across(
      .cols = all_of(
        c("rebate_checks_arp", "federal_other_direct_aid_arp") %>% paste0("_minus_neutral")
      ),
      .fns = ~ mpc_direct_aid_arp(.),
      .names = "{.col}_post_mpc"
    ),
    federal_aid_to_small_businesses_arp_minus_neutral_post_mpc = mpc_small_businesses_arp((federal_aid_to_small_businesses_arp_minus_neutral))
  )

##############################################################################
levels_newCBO <- consumption %>% select(date, consumption_grants, investment_grants, federal_purchases, state_purchases,ends_with('post_mpc'))%>% filter_index("2019 Q4" ~ "2024 Q1") %>% mutate(grants = consumption_grants + investment_grants) %>% mutate(state_purchases_minus_grants = state_purchases - grants) 

#Purchases
federal_purchases_newCBO <-ggplot(data=levels_newCBO, aes(x=date, y=federal_purchases)) + geom_bar(stat="identity") + ggtitle("Federal Purchases (NIPA Consistent, no Grants) New CBO")+ theme(
  axis.title.x = element_blank(),
  axis.title.y = element_blank(),
  axis.line = element_line(colour = "grey"),
  panel.border = element_blank(),
  panel.grid.major = element_blank(),
  panel.background = element_blank(),
  panel.grid.minor = element_blank())


state_purchases_newCBO <-ggplot(data=levels_newCBO, aes(x=date, y=state_purchases_minus_grants)) + geom_bar(stat="identity")+ ggtitle("State Purchases (FIM Consistent, no Grants)New CBO") + theme(
  axis.title.x = element_blank(),
  axis.title.y = element_blank(),
  axis.line = element_line(colour = "grey"),
  panel.border = element_blank(),
  panel.grid.major = element_blank(),
  panel.background = element_blank(),
  panel.grid.minor = element_blank())


#Grants
consumption_grants_newCBO <-ggplot(data=levels_newCBO, aes(x=date, y=consumption_grants)) +
  geom_bar(stat="identity") + ggtitle("Consumption Grants New CBO")+ theme(
    axis.title.x = element_blank(),
    axis.title.y = element_blank(),
    axis.line = element_line(colour = "grey"),
    panel.border = element_blank(),
    panel.grid.major = element_blank(),
    panel.background = element_blank(),
    panel.grid.minor = element_blank())


investment_grants_newCBO <-ggplot(data=levels_newCBO, aes(x=date, y=investment_grants)) +
  geom_bar(stat="identity") + ggtitle("Investment Grants New CBO") + theme(
    axis.title.x = element_blank(),
    axis.title.y = element_blank(),
    axis.line = element_line(colour = "grey"),
    panel.border = element_blank(),
    panel.grid.major = element_blank(),
    panel.background = element_blank(),
    panel.grid.minor = element_blank())



#Subsidies
federal_subsidies_newCBO <-ggplot(data=levels_newCBO, aes(x=date, y=federal_subsidies_post_mpc)) +geom_bar(stat="identity") + ggtitle("Non-ARP Subsidies plus ARP Provider Relief and PPP New CBO")+ theme(
  axis.title.x = element_blank(),
  axis.title.y = element_blank(),
  axis.line = element_line(colour = "grey"),
  panel.border = element_blank(),
  panel.grid.major = element_blank(),
  panel.background = element_blank(),
  panel.grid.minor = element_blank())


federal_aid_to_small_businesses_arp_newCBO <- ggplot(data=levels_newCBO, aes(x=date, y=federal_aid_to_small_businesses_arp_minus_neutral_post_mpc)) +geom_bar(stat="identity") + ggtitle("ARP Subsidies less Provider Relief and PPP New CBO")+ theme(
  axis.title.x = element_blank(),
  axis.title.y = element_blank(),
  axis.line = element_line(colour = "grey"),
  panel.border = element_blank(),
  panel.grid.major = element_blank(),
  panel.background = element_blank(),
  panel.grid.minor = element_blank())



#Taxes
federal_non_corporate_taxes_newCBO <-ggplot(data=levels_newCBO, aes(x=date, y=federal_non_corporate_taxes_post_mpc)) +geom_bar(stat="identity")+ ggtitle("Federal Non-Corporate Taxes New CBO")+ theme(
  axis.title.x = element_blank(),
  axis.title.y = element_blank(),
  axis.line = element_line(colour = "grey"),
  panel.border = element_blank(),
  panel.grid.major = element_blank(),
  panel.background = element_blank(),
  panel.grid.minor = element_blank())


state_non_corporate_taxes_newCBO <-ggplot(data=levels_newCBO, aes(x=date, y=state_non_corporate_taxes_post_mpc)) +geom_bar(stat="identity") + ggtitle("State Non-Corporate Taxes New CBO") + theme(
  axis.title.x = element_blank(),
  axis.title.y = element_blank(),
  axis.line = element_line(colour = "grey"),
  panel.border = element_blank(),
  panel.grid.major = element_blank(),
  panel.background = element_blank(),
  panel.grid.minor = element_blank())

federal_corporate_taxes_newCBO <-ggplot(data=levels_newCBO, aes(x=date, y=federal_corporate_taxes_post_mpc)) +geom_bar(stat="identity") + ggtitle("Federal Corporate Taxes New CBO")+ theme(
  axis.title.x = element_blank(),
  axis.title.y = element_blank(),
  axis.line = element_line(colour = "grey"),
  panel.border = element_blank(),
  panel.grid.major = element_blank(),
  panel.background = element_blank(),
  panel.grid.minor = element_blank())


state_corporate_taxes_newCBO <-ggplot(data=levels_newCBO, aes(x=date, y=state_corporate_taxes_post_mpc)) +geom_bar(stat="identity") + ggtitle("State Corporate Taxes New CBO")+ theme(
  axis.title.x = element_blank(),
  axis.title.y = element_blank(),
  axis.line = element_line(colour = "grey"),
  panel.border = element_blank(),
  panel.grid.major = element_blank(),
  panel.background = element_blank(),
  panel.grid.minor = element_blank())


#Rebate Checks
rebate_checks_non_arp_newCBO<-ggplot(data=levels_newCBO, aes(x=date, y=rebate_checks_post_mpc)) + geom_bar(stat="identity")  + ggtitle("Non-ARP Rebate Checks New CBO")+ theme(
  axis.title.x = element_blank(),
  axis.title.y = element_blank(),
  axis.line = element_line(colour = "grey"),
  panel.border = element_blank(),
  panel.grid.major = element_blank(),
  panel.background = element_blank(),
  panel.grid.minor = element_blank())


rebate_checks_arp_newCBO <-ggplot(data=levels_newCBO, aes(x=date, y=rebate_checks_arp_minus_neutral_post_mpc)) + geom_bar(stat="identity") + ggtitle("ARP Rebate Checks New CBO")+ theme(
  axis.title.x = element_blank(),
  axis.title.y = element_blank(),
  axis.line = element_line(colour = "grey"),
  panel.border = element_blank(),
  panel.grid.major = element_blank(),
  panel.background = element_blank(),
  panel.grid.minor = element_blank())


#UI
federal_ui_newCBO <-ggplot(data=levels_newCBO, aes(x=date, y=federal_ui_minus_neutral_post_mpc)) +geom_bar(stat="identity")  + ggtitle("Federal Unemployment Insurance New CBO")+ theme(
  axis.title.x = element_blank(),
  axis.title.y = element_blank(),
  axis.line = element_line(colour = "grey"),
  panel.border = element_blank(),
  panel.grid.major = element_blank(),
  panel.background = element_blank(),
  panel.grid.minor = element_blank())


state_ui_newCBO <-ggplot(data=levels_newCBO, aes(x=date, y=state_ui_minus_neutral_post_mpc)) +geom_bar(stat="identity")  + ggtitle("State Unemployment Insurance New CBO")+ theme(
  axis.title.x = element_blank(),
  axis.title.y = element_blank(),
  axis.line = element_line(colour = "grey"),
  panel.border = element_blank(),
  panel.grid.major = element_blank(),
  panel.background = element_blank(),
  panel.grid.minor = element_blank())


#Health Outlays
federal_health_outlays_newCBO <-ggplot(data=levels_newCBO, aes(x=date, y=federal_health_outlays_post_mpc)) +geom_bar(stat="identity")  + ggtitle("Federal Health Outlays New CBO")+ theme(
  axis.title.x = element_blank(),
  axis.title.y = element_blank(),
  axis.line = element_line(colour = "grey"),
  panel.border = element_blank(),
  panel.grid.major = element_blank(),
  panel.background = element_blank(),
  panel.grid.minor = element_blank())


state_health_outlays_newCBO <-ggplot(data=levels_newCBO, aes(x=date, y=state_health_outlays_post_mpc)) +geom_bar(stat="identity")  + ggtitle("State Health Outlays New CBO") + theme(
  axis.title.x = element_blank(),
  axis.title.y = element_blank(),
  axis.line = element_line(colour = "grey"),
  panel.border = element_blank(),
  panel.grid.major = element_blank(),
  panel.background = element_blank(),
  panel.grid.minor = element_blank())
 

#Other Social Benefits
federal_social_benefits_newCBO <-ggplot(data=levels_newCBO, aes(x=date, y=federal_social_benefits_post_mpc)) +geom_bar(stat="identity") + ggtitle("Federal Social Benefits New CBO")+ theme(
  axis.title.x = element_blank(),
  axis.title.y = element_blank(),
  axis.line = element_line(colour = "grey"),
  panel.border = element_blank(),
  panel.grid.major = element_blank(),
  panel.background = element_blank(),
  panel.grid.minor = element_blank())


state_social_benefits_newCBO <-ggplot(data=levels_newCBO, aes(x=date, y=state_social_benefits_post_mpc)) +geom_bar(stat="identity") +ggtitle("State Social Benefits New CBO") + theme(
  axis.title.x = element_blank(),
  axis.title.y = element_blank(),
  axis.line = element_line(colour = "grey"),
  panel.border = element_blank(),
  panel.grid.major = element_blank(),
  panel.background = element_blank(),
  panel.grid.minor = element_blank())


#ARP Other Vulnerable and Other Direct Aid
federal_other_vulnerable_arp_newCBO <- ggplot(data=levels_newCBO, aes(x=date, y=federal_other_vulnerable_arp_minus_neutral_post_mpc)) +geom_bar(stat="identity") + ggtitle("Other Vulnerable (ARP) New CBO")+ theme(
  axis.title.x = element_blank(),
  axis.title.y = element_blank(),
  axis.line = element_line(colour = "grey"),
  panel.border = element_blank(),
  panel.grid.major = element_blank(),
  panel.background = element_blank(),
  panel.grid.minor = element_blank()) 


federal_other_direct_aid_arp_newCBO <- ggplot(data=levels_newCBO, aes(x=date, y=federal_other_direct_aid_arp_minus_neutral_post_mpc)) +geom_bar(stat="identity") + ggtitle("Other Direct Aid (ARP) New CBO") + theme(
  axis.title.x = element_blank(),
  axis.title.y = element_blank(),
  axis.line = element_line(colour = "grey"),
  panel.border = element_blank(),
  panel.grid.major = element_blank(),
  panel.background = element_blank(),
  panel.grid.minor = element_blank())


federal_purchases
federal_purchases_newCBO
state_purchases
state_purchases_newCBO
consumption_grants
consumption_grants_newCBO
investment_grants
investment_grants_newCBO
federal_subsidies 
federal_subsidies_newCBO
federal_aid_to_small_businesses_arp
federal_aid_to_small_businesses_arp_newCBO
federal_non_corporate_taxes
federal_non_corporate_taxes_newCBO
state_non_corporate_taxes
state_non_corporate_taxes_newCBO
federal_corporate_taxes
federal_corporate_taxes_newCBO
state_corporate_taxes
state_corporate_taxes_newCBO
rebate_checks_non_arp 
rebate_checks_non_arp_newCBO
rebate_checks_arp 
rebate_checks_arp_newCBO 
federal_ui
federal_ui_newCBO
state_ui 
state_ui_newCBO
federal_health_outlays
federal_health_outlays_newCBO
state_health_outlays 
state_health_outlays_newCBO
federal_social_benefits 
federal_social_benefits_newCBO
state_social_benefits
state_social_benefits_newCBO
federal_other_vulnerable_arp 
federal_other_vulnerable_arp_newCBO
federal_other_direct_aid_arp
federal_other_direct_aid_arp_newCBO

#Ask how to save as PDF (having trouble with the methods I'm finding online)